home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE15 / IDAPI / Locklist / LOCKINFO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-14  |  7.2 KB  |  244 lines
  1. unit LockInfo;
  2.  
  3. interface
  4.  
  5. uses SysUtils, DbiTypes, DbiProcs, DbiErrs, DBTables;
  6.  
  7. type
  8.   TLockType = (lkRecordWrite, lkRecordRead, lkPdoxGroup, lkPdoxImage,
  9.                lkOpen, lkRead, lkWrite, lkExcl, lkError, lkUnknown,
  10.                lkIgnore);
  11.  
  12.   TLockInfoType = (liLockType, liUsername, liNetSess, liLocalSess, liRecNo);
  13.  
  14.   TUserName = string[DBIMAXUSERNAMELEN];
  15.   TLookFor  = set of TLockInfoType;
  16.   TScores   = set of 1..5;
  17.  
  18.   TLocksList = class(TObject)
  19.   private
  20.     FMaxScore:    TScores;
  21.     FCursor:      HDBICur;
  22.     FLookFor:     TLookFor;
  23.     FLockDesc:    LOCKDesc;
  24.     FLockType:    TLockType;
  25.     FUserName:    TUserName;
  26.     FNetSession:  Word;
  27.     FOurSession:  Word;
  28.     FRecNumber:   LongInt;
  29.     FDoFindFirst: Boolean;
  30.     FTable:       TTable;
  31.     procedure OpenLockList;
  32.     procedure SetLockType(const Value: TLockType);
  33.     procedure SetUser(const Value: TUserName);
  34.     function  GetUser: TUserName;
  35.     procedure SetNetSess(const Value: Word);
  36.     procedure SetOurSess(const Value: Word);
  37.     procedure SetRecNo(const Value: LongInt);
  38.     procedure SetTable(const Value: TTable);
  39.     procedure SetLookFor(const Value: TLookFor);
  40.   public
  41.     constructor Create;
  42.     destructor Destroy; override;
  43.     procedure SetParams(const LType: TLockType; const LUser: TUserName;
  44.                         const LNetSess, LOurSess: Word; const LRecNo: LongInt);
  45.     function FindFirst(var LockInfo: LOCKDesc): Boolean;
  46.     function FindNext(var LockInfo: LOCKDesc): Boolean;
  47.     property Table: TTable read FTable write SetTable;
  48.     property LockType: TLockType read FLockType write SetLockType;
  49.     property UserName: TUserName read GetUser write SetUser;
  50.     property NetSession: Word read FNetSession write SetNetSess;
  51.     property LocalSession: Word read FOurSession write SetOurSess;
  52.     property RecNo: LongInt read FRecNumber write SetRecNo;
  53.     property LookFor: TLookFor read FLookFor write SetLookFor;
  54.   end;
  55.  
  56. function GetLockUser(ATable: TTable; RecNum: LongInt): TUserName;
  57.  
  58. implementation
  59.  
  60. uses DB;
  61.  
  62. function GetLockUser(ATable: TTable; RecNum: LongInt): TUserName;
  63. var LckDesc: LOCKDesc;
  64.     LckCur:  HDbiCur;
  65. begin
  66.   Result := '';
  67.   Check(DbiOpenLockList(ATable.Handle, True, False, LckCur));
  68.   Check(DbiSetToBegin(LckCur));
  69.   while (DbiGetNextRecord(LckCur, dbiNOLOCK, @LckDesc, nil) = DBIERR_NONE) do
  70.     if (LckDesc.iRecNum = RecNum) then
  71.     begin
  72.       Result := StrPas(LckDesc.szUserName);
  73.       break;
  74.     end;
  75.   Check(DbiCloseCursor(LckCur));
  76. end;
  77.  
  78. constructor TLocksList.Create;
  79. begin
  80.   FDoFindFirst := True;
  81.   FCursor      := nil;
  82.   FUserName    := '';
  83.   FLookFor     := [liLockType,liUsername,liNetSess,liLocalSess,liRecNo];
  84. end;
  85.  
  86. destructor TLocksList.Destroy;
  87. begin
  88.   if FCursor <> nil then Check(DbiCloseCursor(FCursor));
  89. end;
  90.  
  91. procedure TLocksList.OpenLockList;
  92. begin
  93.   if not FTable.Active then raise Exception.Create('Table is closed');
  94.   if FCursor <> nil then Check(DbiCloseCursor(FCursor));
  95.   FCursor := nil;
  96.   Check(DbiOpenLockList(FTable.Handle, True, True, FCursor));
  97.   Check(DbiSetToBegin(FCursor));
  98. end;
  99.  
  100. procedure TLocksList.SetTable(const Value: TTable);
  101. begin
  102.   if not Value.Active then raise Exception.Create('Table is closed');
  103.   FTable := Value;
  104. end;
  105.  
  106. procedure TLocksList.SetLookFor(const Value: TLookFor);
  107. begin
  108.   FLookFor := Value;
  109.   FDoFindFirst := True;
  110. end;
  111.  
  112. procedure TLocksList.SetParams(const LType: TLockType; const LUser: TUserName;
  113.                                const LNetSess, LOurSess: Word;
  114.                                const LRecNo: LongInt);
  115. begin
  116.   FUserName   := LUser;
  117.   FLockType   := LType;
  118.   FNetSession := LNetSess;
  119.   FOurSession := LOurSess;
  120.   FRecNumber  := LRecNo;
  121.  
  122.   FDoFindFirst := True;
  123. end;
  124.  
  125. function TLocksList.FindFirst(var LockInfo: LockDesc): Boolean;
  126. var Score, DefScore: TScores;
  127.     RetCode: DBIResult;
  128. begin
  129.   Result    := False;
  130.   FMaxScore := [1,2,3,4,5];
  131.   DefScore  := [];
  132.  
  133.   OpenLockList;
  134.   FDoFindFirst := False;
  135.  
  136.   if not(liLockType in FLookFor) then Include(DefScore,1);
  137.   if not(liUsername in FLookFor) then Include(DefScore,2);
  138.   if not(liNetSess in FLookFor) then Include(DefScore,3);
  139.   if not(liLocalSess in FLookFor) then Include(DefScore,4);
  140.   if not(liRecNo in FLookFor) then Include(DefScore,5);
  141.  
  142.   repeat
  143.     with FLockDesc do
  144.     begin
  145.       RetCode := DbiGetNextRecord(FCursor, dbiNOLOCK, @FLockDesc, nil);
  146.       if RetCode <> DBIERR_NONE then break;
  147.       Score := DefScore;
  148.  
  149.       if (liLockType in FLookFor) and (TLockType(iType) = FLockType) then
  150.         Include(Score,1);
  151.       if (liUsername in FLookFor) and
  152.          (CompareText(StrPas(FLockDesc.szUsername), FUserName) = 0)
  153.       then Include(Score,2);
  154.       if (liNetSess in FLookFor) and (FNetSession = iNetSession) then
  155.         Include(Score,3);
  156.       if (liLocalSess in FLookFor) and (FOurSession = iSession) then
  157.         Include(Score,4);
  158.       if (liRecNo in FLookFor) and (FRecNumber = iRecNum) then
  159.         Include(Score,5);
  160.  
  161.       Result := (Score = FMaxScore);
  162.       if Result then break;
  163.     end;
  164.   until (RetCode <> DBIERR_NONE);
  165.   if Result then Move(FLockDesc, LockInfo, sizeof(FLockDesc));
  166. end;
  167.  
  168. function TLocksList.FindNext(var LockInfo: LockDesc): Boolean;
  169. var Score, DefScore: TScores;
  170.     RetCode: DBIResult;
  171. begin
  172.   Result   := False;
  173.   DefScore := [];
  174.   if FDoFindFirst then raise Exception.Create('Invalid method call: FindNext');
  175.  
  176.   if not(liLockType in FLookFor) then Include(DefScore,1);
  177.   if not(liUsername in FLookFor) then Include(DefScore,2);
  178.   if not(liNetSess in FLookFor) then Include(DefScore,3);
  179.   if not(liLocalSess in FLookFor) then Include(DefScore,4);
  180.   if not(liRecNo in FLookFor) then Include(DefScore,5);
  181.  
  182.   repeat
  183.     with FLockDesc do
  184.     begin
  185.       RetCode := DbiGetNextRecord(FCursor, dbiNOLOCK, @FLockDesc, nil);
  186.       if RetCode <> DBIERR_NONE then break;
  187.       Score := DefScore;
  188.  
  189.       if (liLockType in FLookFor) and (TLockType(iType) = FLockType) then
  190.         Include(Score,1);
  191.       if (liUsername in FLookFor) and
  192.          (CompareText(StrPas(FLockDesc.szUsername), FUserName) = 0)
  193.       then Include(Score,2);
  194.       if (liNetSess in FLookFor) and (FNetSession = iNetSession) then
  195.         Include(Score,3);
  196.       if (liLocalSess in FLookFor) and (FOurSession = iSession) then
  197.         Include(Score,4);
  198.       if (liRecNo in FLookFor) and (FRecNumber = iRecNum) then
  199.         Include(Score,5);
  200.  
  201.       Result := (Score = FMaxScore);
  202.       if Result then break;
  203.     end;
  204.   until (RetCode <> DBIERR_NONE);
  205.   if Result then Move(FLockDesc, LockInfo, sizeof(FLockDesc));
  206. end;
  207.  
  208. procedure TLocksList.SetLockType(const Value: TLockType);
  209. begin
  210.   FLockType    := Value;
  211.   FDoFindFirst := True;
  212. end;
  213.  
  214. procedure TLocksList.SetUser(const Value: TUserName);
  215. begin
  216.   FUserName    := Value;
  217.   FDoFindFirst := True;
  218. end;
  219.  
  220. function TLocksList.GetUser: TUserName;
  221. begin
  222.   Result := FUserName;
  223. end;
  224.  
  225. procedure TLocksList.SetNetSess(const Value: Word);
  226. begin
  227.   FNetSession  := Value;
  228.   FDoFindFirst := True;
  229. end;
  230.  
  231. procedure TLocksList.SetOurSess(const Value: Word);
  232. begin
  233.   FOurSession  := Value;
  234.   FDoFindFirst := True;
  235. end;
  236.  
  237. procedure TLocksList.SetRecNo(const Value: LongInt);
  238. begin
  239.   FRecNumber   := Value;
  240.   FDoFindFirst := True;
  241. end;
  242.  
  243. end.
  244.